home *** CD-ROM | disk | FTP | other *** search
/ Mac100% 1998 November / MAC100-1998-11.ISO.7z / MAC100-1998-11.ISO / ｵﾝﾗｲﾝｿﾌﾄ定点観測 / ﾕｰﾃｨﾘﾃｨ / Mops 3.2.sea / Mops 3.2 / Mops ƒ / Files < prev    next >
Text File  |  1998-05-25  |  15KB  |  638 lines
  1. ¥ Files  - file object and loader
  2.  
  3. cr .( loading Files...)
  4.  
  5. cl1                        ¥ In case we're reloading
  6. ' cl1    -> abortVec
  7.     0    -> quitvec
  8.  
  9.  
  10.     0    value        SFDlgHook    ¥ Used in std file calls.  If non-zero,
  11.                                 ¥  points to the proc to be called while
  12.                                 ¥  the std file dialog is up.
  13.  
  14. -39        constant    EOF            ¥ EOF error return
  15. -43        constant    FNF            ¥ File not found ditto
  16.  
  17. -300     constant    FILE-MARK
  18.  
  19. ¥ Marks the start of a loaded file - we plant some useful info there.
  20. ¥ We put the file name in the dic as if it's a definition name, but use
  21. ¥ file-mark as a "handler code".  Then after that we put the useful info.
  22. ¥ See extrasMod.
  23.  
  24. false    value    ASYNCH?
  25. false    value    ENDLOAD?
  26. false    value    LOG?
  27.  
  28.     0    value    OPEN_CNT
  29.     0    value    CLOSE_ERR_CNT
  30.  
  31. forward    CREATE_LOG
  32. forward    WRITE_LOG
  33.  
  34.     string    $LG1
  35.     string    $LG2
  36.  
  37.  
  38. : ?DISABLE_ACTW
  39.             ¥ deactivates the front window if it's one of ours.  Call before
  40.             ¥  putting up a dialog, since that doesn't automatically cause a
  41.             ¥  deactivate event, for some strange reason.
  42.  
  43.     actW IF  disable: [ actW ]  THEN  ;
  44.  
  45.  
  46. : ASYNCH    true -> asynch?  ;
  47.  
  48. : IOWAIT    BEGIN  busy  0EXIT  pause  AGAIN   ;
  49.  
  50. : (ASY)        ¥ ( fcb -- )  Sets up for a low-level asynchronous read or write.
  51.     IOwait
  52.     -> busy  setCP  ;
  53.  
  54.  
  55. : VOLNAME?  { str -- b } 
  56.     reset: [ str ]
  57.     58 str chsearch: [ str ]
  58.     NIF  false  EXIT  THEN
  59.     lim: [ str ]  2 >=  ;
  60.  
  61.  
  62. forward  OPEN_WITH_PATHS
  63.  
  64. false    value    USE_PATHS?
  65.  
  66. : HFS?    $ 3f6 w@x  0>  ;
  67.  
  68. variable    MyDocName    28 allot
  69.  
  70. : MyDoc        ¥ ( -- addr len )
  71.     MyDocName  count  ;
  72.  
  73.  
  74. ¥ Standard file package support
  75.  
  76. : SFLOC  {  ¥ ht wd -- x:y }
  77.         ¥ Computes screen coordinates for top left of
  78.         ¥ SF dialog box.  Centers the box horizontally, and a bit above
  79.         ¥ the center vertically.
  80.     screenbits  -> ht  -> wd  2drop
  81.     ht 3 /  80 -  0 max  -> ht
  82.     wd 2/  170 -  0 max  -> wd
  83.     wd ht pack  ;
  84.  
  85.  
  86. :class     SFrec    super{ object } 
  87.  
  88. record
  89. {    byte        Good
  90.     byte        count            ¥ actually not used
  91.     var            fType
  92.     int            vRefNum
  93.     int            Version
  94.  64    bytes        Filename        ¥ max size is 64
  95. }
  96. 4    ordered-col    fTypes            ¥ list of filetypes
  97.  
  98.  
  99. :m GetVRefNum:    get: vRefNum   ;m
  100. :m GetName:        addr: FileName   ;m
  101.  
  102. :m CALL:    ¥ ( routine# -- bool )  Calls a Standard File Package routine.
  103.     ?disable_actw
  104.     SFDlgHook  ^base  rot makeint  trap$ A9EA
  105.     get: good  ;m
  106.  
  107. :m STDGET:  ( type0 ...typeN ) {  #types -- bool } 
  108.     clear: fTypes  #types  0>
  109.     IF    #types 0  DO  add: fTypes  LOOP  THEN
  110.     SFloc  0 0  #types makeint  ixAddr: fTypes
  111.     2 call: self  ;m
  112.  
  113. :m STDPUT:  {  pAddr pLen nAddr nLen -- bool } 
  114.     pAddr pLen pad place
  115.     SFloc  pad  nAddr nLen  str255
  116.     1 call: self  ;m
  117.  
  118. ;class 
  119.  
  120.  
  121. objHandle    SFHDL
  122. objPtr        SFOBJ   class_is  SFrec
  123.  
  124.  
  125. ¥ DO_OPEN does the hard work for OPEN: file.  First, if either the DirID
  126. ¥ or the vol ref# is non-zero, we rashly assume we know which folder we
  127. ¥ want, and just do an open.  We also do that if we're not running under HFS.
  128. ¥ Then, if we get through to here, we need to look at the paths.  But wait!
  129. ¥ First, we check the default folder by just doing a plain open anyway!  If
  130. ¥ this fails with a "file not found", we call ?USE_PATHS which either does
  131. ¥ nothing (if we're not using a path designator file), or calls our PATHSMOD
  132. ¥ module to look at a PD file and try using those paths to find the wanted
  133. ¥ file.
  134.  
  135. : DO_OPEN  {  fcb mode -- rc } 
  136.     1 ++> open_cnt
  137.     ^base 48 + @                    ¥ DirID
  138.     ^base 22 + w@                    ¥ vol ref#
  139.     or  HFS? not  or                ¥ Either non-zero, or not HFS?
  140.     use_paths? not  or                ¥ Or paths disabled?
  141.     IF                                ¥ Yes: just do a normal open, and get out.
  142.         fcb mode (open)  EXIT
  143.     THEN
  144.                                     ¥ Maybe use HFS paths:
  145.     fcb mode (open) dup  0EXIT        ¥ Try default folder first
  146.                                     ¥ -- out if we found it
  147.     dup FNF <>  ?EXIT                ¥ If err wasn't FNF, get out
  148.     use_paths?  0EXIT                ¥ If paths disabled, out with FNF
  149.     drop  fcb mode open_with_paths  ;
  150.  
  151.  
  152. :class   FILE    super{ object }        general
  153.  
  154. 134    bytes        FCB            ¥ max parameter block (108 but for hgetvinfo)
  155.  
  156. record    FSSpec
  157. {    int            FSvRefNum
  158.     var            FSDirID
  159. 64    bytes        FileName
  160. }
  161.  
  162. :m CLEAR:        ¥ Clears the fcb, except for the filename.
  163.     ^base  18 erase  ^base 22 +  112 erase  ;m
  164.  
  165. :m SETNAMEPTR:    ¥ Sets filename pointer in the FCB.
  166.     ^base 140 +  ^base !fptr  ;m
  167.  
  168. :m NAME:        ¥ ( addr len -- )  Assigns file name to fcb.  Rest cleared.
  169.     setNamePtr: self  clear: self
  170.     ^base 140 +  >r                    ¥ Addr of filename (at end of fcb)
  171.     r@  64 blanks
  172.     ( addr len )  64 min  r>  >str255  drop  ;m
  173.  
  174. :m SETDIRID:    ¥ ( dirid -- )  Sets the DirID for the fcb
  175.     ^base 48 +  !  ;m
  176.  
  177. :m GETDIRID:    ¥ ( -- dirid )  Gets the DirID for the fcb
  178.     ^base 48 +  @  ;m
  179.  
  180. :m GETFREF:    ¥ ( -- fref )  Gets the file ref number.
  181.     ^base 24 +  w@  ;m
  182.  
  183. :m SETFREF:
  184.     ^base 24 +  w!  ;m
  185.  
  186. :m SETVREF:    ¥ ( vref# -- )  Sets the volRefNum for the fcb
  187.     ^base 22 +  w!  ;m
  188.  
  189. :m GETVREF:    ¥ ( -- vref# )  Gets the volRefNum for the fcb
  190.     ^base 22 +  w@  ;m
  191.  
  192.  
  193. :m CLOSE:    ¥ ( -- rc )   Needs to clear the file RefNum field,
  194.             ¥ as advised in Mac Tech note # 102.  In fact we clear
  195.             ¥ the whole fcb except the name and Vref, so we can reuse
  196.             ¥ the fcb for a subsequent operation without the extra info
  197.             ¥ left by read and write calls being interpreted as HFS info.
  198.             
  199.     ^base  (close)  getVref: self  clear: self  setVref: self
  200.     dup if  1 ++> close_err_cnt  else  -1 ++> open_cnt  then  ;m
  201.  
  202.  
  203. :m OPEN:    ¥ ( -- rc )
  204.     ^base 0 do_open  ;m
  205.  
  206. :m OPENREADONLY:
  207.     ^base 1 do_open  ;m
  208.  
  209.  
  210. :m NEW:    ^base  (make)  ;m
  211.  
  212. :m DELETE:    ^base (delete)  ;m
  213.  
  214. :m MOVETO:    ¥ ( byteoffset -- rc )  Positions relative to start of file
  215.     ^base 1 rot  (lseek)  ;m
  216.  
  217. :m POS:        ¥ ( -- byteoffset )
  218.     ^base  $ 2E +  @  ;m
  219.  
  220. :m SETEOF:    ¥ ( pos -- rc )  Sets end-of-file to absolute byte position
  221.     ^base 28 + !  ^base fdos$ a012  ;m
  222.  
  223. :m CREATE:  { ¥ volID -- rc } 
  224.             ¥ Opens and resets file or creates new if not present.
  225.     1 ++> open_cnt
  226.     ^base 0 (open)                ¥ Attempt to open - don't use paths
  227.     ?dup
  228.     IF    dup FNF =
  229.         IF    drop
  230.             new: self  ?dup NIF  ^base 0 (open)  THEN
  231.         THEN
  232.     ELSE
  233.         0 setEOF: self
  234.     THEN  ;m
  235.  
  236. :m CREATENEW:    ¥ ( -- rc )  Like create:, but if file exists it's deleted
  237.                 ¥  and created totally new.
  238.     delete: self  drop
  239.     create: self  ;m
  240.  
  241. :m LAST:        ¥ Positions to end of file.
  242.     big# moveto: self  drop  ;m
  243.  
  244. :m SIZE:        ¥ ( -- #bytes )  Returns logical eof for file currently open
  245.     ^base fdos$ a011  drop ^base 28 + @  ;m
  246.  
  247. :m BYTESREAD:    ¥ ( -- n )  Returns actual bytes read.
  248.     ^base 40 + @  ;m
  249.  
  250. :m FCB:  ( -- fcb )     ^base  ;m
  251.  
  252. :m RESULT:    ¥ ( -- rc )  Returns the last I/O result code.
  253.     ^base 16 + w@  ;m
  254.  
  255. :m MODE:        ¥ ( posMode -- )  Sets position mode
  256.     ^base 44 + w!  ;m
  257.  
  258.  
  259. :m WAIT:    ¥ ( -- rc )  Waits for asynch I/O on this file to finish.
  260.     BEGIN    ^base busy =
  261.         NIF   ^base 16 + w@x  EXIT  THEN
  262.         pause
  263.     AGAIN  ;m
  264.  
  265. :m ?WAIT:    ¥ ( rc1 -- rc2 )
  266.     asynch?
  267.     NIF        drop  wait: self
  268.     ELSE    false -> asynch?
  269.     THEN   ;m
  270.  
  271.  
  272. :m READ:        ¥ ( addr length -- rc )
  273.     0 mode: self ^base swap rot
  274.     ^base (asy)  (read)  ?wait: self  ;m
  275.  
  276. :m READLINE:    ¥ ( addr maxLen -- rc )  Reads terminating with CR
  277.     $ 0D80 mode: self  ^base  swap rot
  278.     ^base (asy)  (read)  ?wait: self  ;m
  279.  
  280. :m WRITE:        ¥ ( addr length -- rc )
  281.     ^base  swap rot
  282.     ^base (asy)  (write)  ?wait: self  ;m
  283.  
  284. :m SETNAME:        ¥ Gets name from input stream, and assigns to fcb.
  285.     & "  parse-word  name: self  ;m
  286.  
  287. :m GETNAME:        ¥ ( -- addr len )  Returns filename
  288.     addr: fileName  count  ;m
  289.  
  290. :m PRINT:        ¥ Prints the filename.
  291.     getName: self  type  ;m
  292.  
  293. :m GETFILEINFO:        ¥ ( -- rc )  Fills the parameter block with file info
  294.     ^base fdos$ A20C  ;m
  295.  
  296. :m SETFILEINFO:        ¥ ( -- rc )
  297.     ^base fdos$ A20D  ;m
  298.  
  299. :m SET:  { ftyp sig -- }            ¥ Sets file type, signature.
  300.     getDirID: self                    ¥ Save DirID
  301.     0 setDirID: self                ¥ and clear it (otherwise we'll get
  302.     getFileInfo: self  drop            ¥  "file not found")
  303.     sig  ^base  $ 24 +  !            ¥ Set signature
  304.     ftyp ^base  $ 20 +  !            ¥ Set type
  305.     0 setDirID: self
  306.     setFileInfo: self  drop
  307.     setDirID: self  ;m                ¥ Restore DirID
  308.  
  309.  
  310. :m DRIVE:    ¥ ( drive# -- )  set default drive to drive#
  311.     clear: self  setVRef: self  ^base fdos$ a015
  312.     ?error 165  ;m
  313.  
  314.  
  315. :m ACCEPT:  { addr len ¥ #chrs eof? -- #chrs eof? }     ¥ ACCEPTs from disk.
  316.     echo? IF  addr len erase  THEN        ¥ So the typed line is OK
  317.     addr len  readLine: self  -> eof?
  318.     bytesRead: self  eof? NIF  1-  THEN  -> #chrs
  319.     #chrs 0=  eof? and  IF  0  true  EXIT  THEN
  320.     addr #chrs +  c@  13 <>
  321.     IF                                ¥ Overlength line. Probably a comment.
  322.         BEGIN                        ¥ Gobble to CR or EOF
  323.             pad 100  readLine: self  -> eof?
  324.             eof?
  325.             IF        true
  326.             ELSE    pad  bytesRead: self  1-  +  c@ 13 =
  327.             THEN
  328.         UNTIL
  329.     THEN
  330.     #chrs -> len
  331.     echo?
  332.     IF    addr len type  cr  THEN
  333.     BEGIN                            ¥ Loop to convert tabs to blanks
  334.         addr len  9 scan  -> len  -> addr
  335.         len
  336.     WHILE
  337.         bl addr c!
  338.     REPEAT
  339.     #chrs  false   ;m
  340.  
  341.  
  342. :m RENAME: { taddr tlen -- rc } 
  343.     taddr tlen str255
  344.     ^base 28 + !  ^base fdos$ A00B  ;m
  345.  
  346.  
  347. :m GETTYPE:        ¥ ( -- type )
  348.     ^base 32 + @  ;m
  349.  
  350. :m FLUSHVOL:
  351.     ^base fdos$ A013  drop  ;m
  352.  
  353.  
  354. :m CLASSINIT:        clear: self  setNamePtr: self  ;m
  355.  
  356.  
  357. ¥ Standard file package calls.  If the value SFDlgHook is non-zero, we take it as the
  358. ¥ address of a dialog hook routine.
  359.  
  360. private
  361.  
  362. :m SFPCALL:        ¥ ( various get? -- b )  Calls a Standard File Package routine
  363.     classinit: self                        ¥ Make sure name pointer is right
  364.     ['] SFrec  newObj: SFhdl
  365.     obj: SFhdl  -> SFobj
  366.     IF    stdGet: SFobj  ELSE  stdPut: SFobj  THEN
  367.     IF    getVRefNum: SFobj  clear: self  setVref: self
  368.         getName: SFobj  count  addr: fileName  place
  369.         true
  370.     ELSE
  371.         false
  372.     THEN
  373.     release: SFhdl  ;m
  374.  
  375. public
  376.  
  377. :m STDGET:    ¥ ( type0 ...typeN #types -- bool )
  378.     true sfpCall: self  ;m
  379.  
  380. :m STDPUT:    ¥ ( pAddr pLen nAddr nLen -- bool )
  381.     false sfpCall: self  ;m
  382.  
  383. ;class 
  384.  
  385.  
  386. ' fFcb  set_to_class  file            ¥ Make fFcb a FILE objPtr
  387. 6    fFcb 8 -    w!
  388. ' file    fFcb 6 -    reloc!
  389. -6    fFcb 2 -    w!
  390.  
  391.  
  392. ¥ GetDirID returns the dirID of the last directory opened by a
  393. ¥ standard file call.
  394.  
  395. : GETDIRID    $ 398 @  ;
  396.  
  397.  
  398. ¥ FileList keeps a stack of open load files for nested loads.
  399.  
  400. objPtr    TOPFILE  class_is  file
  401.  
  402.  
  403. :class     FILELIST  super{ handleArray } 
  404.  
  405. :m DROP:
  406.     top: super                        ¥ Give error if empty
  407.     close: topFile  drop
  408.     drop: super
  409.     size: super  NIF  nilP  ELSE  obj: self  THEN
  410.     -> topFile
  411.     false -> endload?   ;m
  412.  
  413. :m PUSHNEW:        ¥ Adds a new file to the stack
  414.     ['] file  pushNewObj: self
  415.     false -> endload?
  416.     obj: self  -> topFile            ¥ Note this locks the file object
  417.                                     ¥ -- this is what we want.
  418.     0 setVref: topFile   ;m
  419.  
  420. :m CLEAR:    ¥ Removes all currently open files
  421.     false -> endload?
  422.     get: size  0EXIT
  423.     type# 180  ( File stack: )  cr  top: self
  424.     get: size  FOR
  425.         print: topFile  cr  drop: self
  426.     NEXT  ;m
  427.  
  428. ;class 
  429.  
  430.  
  431. 10    fileList    LOADFILE
  432.  
  433. 0    value        FILESTART_DP
  434. 0    value        CNT
  435. 0    value        SvLATEST
  436.  
  437.  
  438. : LOGIT
  439.     state  0EXIT                    ¥ Out if we're not compiling
  440.     here filestart_DP -  pad w!
  441.     pos: topFile  src-len -
  442.     pad 2+  !
  443.     pad 6  add: $lg1  ;
  444.  
  445.  
  446. 0    value    LASTPOS
  447.  
  448. : LOGCR
  449.     state  0EXIT
  450.     here lastPos <=  ?EXIT
  451.     here -> lastPos
  452.     pad 14 erase
  453.     here filestart_DP -  pad w!
  454.     latest svLatest <> IF  true pad 4+ c!  latest -> svLatest  THEN
  455.     pad 14  add: $lg2  ;
  456.  
  457.  
  458. : (FREFILL)        ¥ ( -- flag )  Does a refill from a file.
  459.     emb_obj_offs
  460.     echo?
  461.     IF        ?pause
  462.     ELSE    cnt NIF  ?pause  20 -> cnt  else  1 --> cnt  THEN
  463.     THEN
  464.     log? IF  logCR  THEN
  465.     tib tibLen  accept: topfile  ( #chrs eof? ) -> endload?  #tib !
  466.     set_source
  467.     -> emb_obj_offs
  468.     endload? 0=  ;
  469.  
  470. ' (Frefill) -> Frefill
  471.  
  472.  
  473. : (LD)
  474.     BEGIN
  475.         endload? IF  false -> endload?  EXIT  THEN
  476.         topfile -> source-ID  (Frefill)  IF  interpret  THEN
  477.         state not  echo? and  fWind? and  IF  ok  THEN
  478.     AGAIN  ;
  479.  
  480.  
  481. false    value    DO_CR?
  482.  
  483. : ?file_open_error  { OSErr -- }
  484.     OSErr  0EXIT                        ¥ out if no error
  485.     getName: topfile  type
  486.     OSErr FNF = IF  132 die  THEN        ¥ file not found
  487.     OSErr cr .  155 die                    ¥ other error opening file
  488. ;
  489.  
  490.  
  491. forward PPC_mark_file
  492.  
  493. : mark_file  ( addr len -- )
  494.     crossed?
  495.     IF        PPC_mark_file
  496.     ELSE    mark_file
  497.     THEN
  498. ;
  499.  
  500.     
  501. : LOADTOP  {  ¥ svCurs svDP svCDP svDepth -- } 
  502.                             ¥ Interprets the file as a Mops source file.
  503.     openReadOnly: topfile  ?file_open_error
  504.     curs -> svCurs  -curs
  505.     cr
  506.     size: loadFile 2*  spaces  type# 173 ( Loading: ) 
  507.     getName: topfile  type
  508.     log? IF
  509.         create_log  ['] logit  -> logVec
  510.         0 -> svLatest
  511.     THEN
  512.     DP -> svDP  CDP -> svCDP  depth -> svDepth
  513.     false -> endload?  false -> do_cr?
  514.     (ld)
  515.     ['] null  -> logvec
  516.     close: topfile  drop  log? IF write_log  THEN
  517.     do_cr?
  518.     IF  cr  size: loadFile 2*  ELSE  2  THEN  spaces  true -> do_cr?
  519.     crossed?
  520.     IF
  521.         ." Code: "
  522.         CDP 
  523.         svCDP IF  svCDP  ELSE  code_start  THEN  -  .
  524.         DP  svDP  -  ."   data: "  .
  525.     ELSE
  526.         DP  svDP  -  ." Size: "  .
  527.     THEN
  528.     size: loadFile 1 <= IF  cr  THEN
  529.     depth svDepth <> IF  cr msg# 75  THEN
  530.                     ¥ Warning - stack depth different after load
  531.     svCurs -> curs  ;
  532.  
  533.  
  534. : ENDLOAD        true -> endload?  0 -> src-len  ;
  535.  
  536.  
  537. ¥ Nesting loader.  Usage: // filename
  538.  
  539. : //  {  ¥ svcurs addr len -- } 
  540.     pushNew: loadFile  setName: topFile
  541.     getName: topFile  mark_file
  542.     loadTop
  543.     drop: loadFile  ;
  544.  
  545.  
  546. ¥        ============= Module support ============
  547.  
  548. : NOMOD        -1 -> modbase  -1 -> MBcomp  0 -> CompMod  ;
  549.  
  550.  
  551. : LDFROMMOD {  newModbase ¥ svModbase svMBcomp -- } 
  552.         ¥ Load from a module.  We save and restore the current
  553.         ¥ modbase and MBcomp value, in case the load changes them.
  554.  
  555.     modbase -> svModbase  MBcomp -> svMBcomp
  556.     newModbase  dup  -> modbase  -> MBcomp
  557.     loadtop
  558.     svModbase -> modbase  svMBcomp -> MBcomp  ;
  559.  
  560.  
  561. ¥        ================= Save =================
  562.  
  563. 'type COM    constant    SAVETYPE    ¥ file type = 'COM '
  564. 'type Mops    constant    SAVESIG        ¥ Signature = 'Mops'
  565.  
  566. : SAVE_THIS    ¥ ( -- addr len )  Defines what to save
  567.     ['] latest
  568.     crossed? IF CDP ELSE DP THEN    ¥ end of dic to save
  569.     over -  ;
  570.  
  571.  
  572. ¥ PURGE gets rid of all loaded modules.  It is defined in the file Modules.
  573. ¥ SAVE needs to call it first, so that saved dic images don't appear to
  574. ¥ reference loaded modules which aren't really loaded.  So that we can call
  575. ¥ SAVE before Modules is loaded, we make PURGE a vector rather than a
  576. ¥ forward definition.
  577.  
  578. ' null    vect    PURGE
  579.  
  580.  
  581. : (SAVE)  {  ¥ savdp savlatest -- rc } 
  582.     create: ffcb  ?error 107
  583.     dp -> savdp  latest -> savlatest
  584.     save_this                        ¥ Call before we clobber DP
  585.     dp    ['] dp -  -> dp                ¥ Here we make DP and LATEST relative
  586.     latest    ['] dp -  -> latest        ¥  to DP so we can set them up when
  587.                                     ¥  saved image is read in
  588.     purge                            ¥ Purge modules so saved image has them all
  589.                                     ¥  unloaded
  590.     0 -> bufPtr                        ¥ Must be zero in saved dics
  591.     true -> savingDic?                ¥ Stops PAUSE from doing anything during
  592.                                     ¥  asynch I/O (could try to call a module,
  593.                                     ¥  but they're purged)
  594.     write: ffcb                        ¥ Leave return code on stack for caller
  595.     false -> savingDic?
  596.     savdp -> dp  savlatest -> latest    ¥ and DP and LATEST
  597.     savetype savesig set: ffcb
  598.     close: ffcb drop
  599. ¥    type# 101 ( Saved: )  getname: ffcb  type  cr  ;
  600. ;
  601.  
  602. : SAVE        ¥ Takes name from input stream.  Redefined later in Frontend.
  603.     setname: ffcb  (save)  ?error 105  ;
  604.  
  605.  
  606. ¥ CL2 is the next cleanup word - it cleans up all file stuff on abort,
  607. ¥ as well as whatever we were doing before (see CL1 in file Class).
  608.  
  609. : CL2
  610.     clear: loadfile  close: ffcb drop
  611.     nomod  release: $lg1  release: $lg2
  612.     ['] null  -> logvec  false -> endload?
  613.     false -> savingDic?
  614.     cl1  ;
  615.  
  616.  
  617. : FILINIT
  618.     ['] file  dup  ['] fFcb  4+  reloc!
  619.     fFcb 18 + @                    ¥ Name pointer - doc name may not be in fFcb
  620.     count  32 min  myDocName place
  621.     fFcb  make_obj
  622.     clear: loadfile  ;
  623.  
  624.  
  625. ' filinit    -> objinit
  626. ' cl2        -> abortvec
  627.  
  628.  
  629. : -ECHO        false -> echo?  ;
  630. : +ECHO        true  -> echo?  ;
  631.  
  632. cr
  633. .( saving interim.dic.  Now type)  cr
  634. .( // sys.ld)  cr
  635. .( to load the rest of the system.)  cr
  636.  
  637. save interim.dic
  638.